knitr::opts_chunk$set(
echo = TRUE,
tidy = FALSE,
size = "small",
out.width = "100%",
message = FALSE,
warning = FALSE
)Airbnb est un service de plateforme communautaire payant de location de logements de particuliers, d’entreprises hôtelières, et d’investisseurs en immobiliers locatifs para-hôteliers fondée en 2008 par les Américains Brian Chesky, Joe Gebbia et Nathan Blecharczyk. Sa principale source de revenu resulte de ses offres de service en terme de loction de logement moyennant un prix pour l’usager
L’object de ce project est d’utiliser l’offre de service Airbnb afin d’apprecier les differents facteurs expliquant le choix ou la preference d’un certain type de choix fait sur les chambres. Ainsi donc, pouvons-nous affirmer par exemple que le prix des chambre peux vraiment explique la qualité de chambre que l’on choisi?.Le but est donc d’utiliser les algorithme de l’apprentissage machine multicasse pour repondre à notre problematique
Nous precisons ici que la population cible dans cette problematique est beacoup plus: les propriétaires de logement, voulant optimiser les prix pour leur appartement et les touristes*
Les données utilisées ici sont des informations par rapport aux propriétés listées sur Airbnb dans la ville de Québec. Disponibles en ligne au lien suivant http://insideairbnb.com/get-the-data.html sous longlet « Quebec City, Quebec, Canada »
library(mlbench)
library(caret)
library(scales)
library(ggpubr)
library(psych)
library(pander)
library(lubridate)
library(knitr)
library(dplyr)
library(outliers)
library(gmodels)
library(readxl)
library(tidyverse)
library(plotly)
library(sqldf)
library(tidyr)
library(Amelia)
library(GGally)
library(tibble)
library(magrittr)
library(forcats)
library(purrr)
library(readr)
library(DT)
library(MASS)
library(data.table)
library(ggplot2)
library(corrplot)
library(RCurl)
#library(googlesheets4)
library(here)
library(ggeasy) # for easy ggplot editing
library(harrypotter)
### Données de calendrier détaillées pour les inscriptions dans la ville de Québec
#con1 <- gzcon(url(paste("http://data.insideairbnb.com/canada/qc/quebec-city/2021-04-11/data/","calendar.csv.gz", #sep="")))
#txt1 <- readLines(con1)
#calendar <- read.csv(textConnection(txt1))
## Données d'examen détaillées pour les inscriptions dans la ville de Québec
#con2 <- gzcon(url(paste("http://data.insideairbnb.com/canada/qc/quebec-city/2021-04-11/data/","reviews.csv.gz", #sep="")))
#txt2 <- readLines(con2)
#reviews <- read.csv(textConnection(txt2))
### Informations sommaires et métriques pour les inscriptions à Québec (bonnes pour les visualisations.
con4 <- gzcon(url(paste("http://data.insideairbnb.com/canada/qc/quebec-city/2021-04-11/data/","listings.csv.gz", sep="")))
txt4 <- readLines(con4)
listing <- read.csv(textConnection(txt4))
attach(listing)
#attach(calendar)
#attach(reviews)Dans cette modelisation,nous avons uniquement utilisé les données sur la table des listings noté listing dans notre ensemble de données
listing$quartier=listing$neighbourhood_cleansed
listing$last_scraped=as.Date(listing$last_scraped)
listing$picture_url <- ifelse(listing$picture_url != "", 1, 0)
listing$host_picture_url <- ifelse(listing$host_picture_url != "", 1, 0)
listing$host_acceptance_rate <- as.numeric(sub("%", "", listing$host_acceptance_rate))
listing$host_response_rate <- as.numeric(sub("%", "", listing$host_response_rate))
listing$host_response_time <- as.factor(listing$host_response_time)
listing$price=gsub('^.|.{3}$', '', listing$price)
listing$price=as.numeric(listing$price)
listing$host_is_superhost <- ifelse(listing$host_is_superhost == "t", 1, 0)
listing$host_thumbnail_url <- ifelse(listing$host_thumbnail_url != "", 1, 0)
listing$price=as.numeric(listing$price)
listing$listing_url <- ifelse(listing$listing_url != "", 1, 0)
listing$instant_bookable <- ifelse(listing$instant_bookable == "t", 1, 0)
listing$host_has_profile_pic <- ifelse(listing$host_has_profile_pic == "t", 1, 0)
listing$host_identity_verified <- ifelse(listing$host_identity_verified == "t", 1, 0)
listing$bedrooms=as.numeric(listing$bedrooms)
listing$beds=as.numeric(listing$beds)
listing$price=as.numeric(listing$price)
listing$minimum_nights=as.numeric(listing$minimum_nights)
listing$maximum_nights=as.numeric(listing$maximum_nights)
listing$minimum_minimum_nights=as.numeric(listing$minimum_minimum_nights)
listing$maximum_minimum_nights =as.numeric(listing$maximum_minimum_nights)
listing$ minimum_maximum_nights=as.numeric(listing$minimum_maximum_nights)
listing$maximum_maximum_nights=as.numeric(listing$maximum_maximum_nights)
listing$availability_30 =as.numeric(listing$availability_30)
listing$availability_60=as.numeric(listing$availability_60)
listing$availability_90=as.numeric(listing$availability_90)
listing$availability_365=as.numeric(listing$availability_365)
listing$number_of_reviews=as.numeric(listing$number_of_reviews)
listing$number_of_reviews_ltm =as.numeric(listing$number_of_reviews_ltm)
listing$number_of_reviews_l30d =as.numeric(listing$number_of_reviews_l30d)
listing$review_scores_rating=as.numeric(listing$review_scores_rating)
listing$review_scores_accuracy=as.numeric(listing$review_scores_accuracy)
listing$review_scores_cleanliness=as.numeric(listing$review_scores_cleanliness)
listing$review_scores_checkin=as.numeric(listing$review_scores_checkin)
listing$review_scores_communication=as.numeric(listing$review_scores_communication)
listing$review_scores_location=as.numeric(listing$ review_scores_location)
listing$review_scores_value =as.numeric(listing$review_scores_value )
listing$calculated_host_listings_count=as.numeric(listing$calculated_host_listings_count)
listing$calculated_host_listings_count_entire_homes=as.numeric(listing$calculated_host_listings_count_entire_homes)
listing$calculated_host_listings_count_private_rooms=as.numeric(listing$calculated_host_listings_count_private_rooms)
listing$calculated_host_listings_count_shared_rooms=as.numeric(listing$calculated_host_listings_count_shared_rooms)
listing$host_thumbnail_url=as.factor(listing$host_thumbnail_url)
listing$picture_url=as.factor(listing$picture_url)
listing$host_picture_url=as.factor(listing$host_picture_url )
listing$host_response_time=as.factor(listing$host_response_time)
listing$host_thumbnail_url=as.factor(listing$host_thumbnail_url )
listing$price=as.numeric(listing$price)
listing$listing_url=as.factor(listing$listing_url )
listing$instant_bookable=as.factor(listing$instant_bookable)
listing$host_has_profile_pic=as.factor(listing$host_has_profile_pic)
listing$host_identity_verified=as.factor(listing$host_identity_verified)Nous avons fait dans un premier temps une selection à priori des variables donc, de pret ou de loin sont pertinentes pour le choix d’une chambre tout en excluant le reste des variables qui n’influecent pas à priori le choix fait sur une chambre
listing1=subset(listing,select=c(accommodates,bedrooms,beds,price,availability_30,availability_60,
availability_365,number_of_reviews,review_scores_rating,reviews_per_month,room_type))
dim(listing1)## [1] 2289 11
pct_na=round(100*listing1 %>% summarise_all(~ sum(is.na(.))) %>% sum()/(nrow(listing1)*ncol(listing1)),1)
paste(pct_na,"% des valeurs sont manquants")## [1] "4.7 % des valeurs sont manquants"
le constat ici est que, nous avons sensiblement 5% de données qui sont manquant dans notre ensemble de données, nous pouvons tout simplement enlever ces observations sans risque de perdre trop d’information.
listing1 %>% summarise_all(~ sum(is.null(.))) %>% sum()## [1] 0
Nous n’avons aucune valeur null dans notre ensemble de données
Nous avons apprecier grace à la matrice de correlation la facons donc les variables continues peuvent etre correllées entre elles
#dd=listing_final_na_free%>% dplyr::select(where(is.numeric))
listing1=na.omit(listing1)
dd=listing1[,1:10]
correlationMatrix <- cor(dd)
knitr::kable(correlationMatrix)| accommodates | bedrooms | beds | price | availability_30 | availability_60 | availability_365 | number_of_reviews | review_scores_rating | reviews_per_month | |
|---|---|---|---|---|---|---|---|---|---|---|
| accommodates | 1.0000000 | 0.7389867 | 0.8384842 | 0.4539165 | 0.0229983 | 0.0157299 | 0.0454113 | 0.0012252 | 0.0392938 | 0.0648132 |
| bedrooms | 0.7389867 | 1.0000000 | 0.6887059 | 0.4875038 | -0.0295626 | -0.0454839 | -0.0006137 | -0.0677132 | 0.0458026 | -0.0616382 |
| beds | 0.8384842 | 0.6887059 | 1.0000000 | 0.4168326 | 0.0067425 | -0.0043661 | 0.0355127 | -0.0163004 | 0.0470434 | 0.0161962 |
| price | 0.4539165 | 0.4875038 | 0.4168326 | 1.0000000 | 0.1196937 | 0.1102180 | 0.1322969 | -0.0913900 | 0.0420884 | -0.1322664 |
| availability_30 | 0.0229983 | -0.0295626 | 0.0067425 | 0.1196937 | 1.0000000 | 0.9614381 | 0.6058655 | 0.0580917 | -0.0947990 | 0.1031444 |
| availability_60 | 0.0157299 | -0.0454839 | -0.0043661 | 0.1102180 | 0.9614381 | 1.0000000 | 0.6638341 | 0.0534939 | -0.0975844 | 0.1113014 |
| availability_365 | 0.0454113 | -0.0006137 | 0.0355127 | 0.1322969 | 0.6058655 | 0.6638341 | 1.0000000 | 0.0648140 | -0.0640785 | 0.0590242 |
| number_of_reviews | 0.0012252 | -0.0677132 | -0.0163004 | -0.0913900 | 0.0580917 | 0.0534939 | 0.0648140 | 1.0000000 | 0.0215629 | 0.7749516 |
| review_scores_rating | 0.0392938 | 0.0458026 | 0.0470434 | 0.0420884 | -0.0947990 | -0.0975844 | -0.0640785 | 0.0215629 | 1.0000000 | 0.0463138 |
| reviews_per_month | 0.0648132 | -0.0616382 | 0.0161962 | -0.1322664 | 0.1031444 | 0.1113014 | 0.0590242 | 0.7749516 | 0.0463138 | 1.0000000 |
Nous avons ensuite exclus les attributs qui sont trop correllés avec un coefficient de correlation >0.75 et en meme temps concu un nouvel ensemble de données
#dd=listing_final_na_free%>% dplyr::select(where(is.numeric))
#correlationMatrix <- cor(dd)
# find attributes that are highly corrected (ideally >0.75)
cutoff <- 0.50
highlyCorrelated <- findCorrelation(correlationMatrix, cutoff=cutoff)
# create a new dataset without highly corrected features
dataset <- listing1[,-highlyCorrelated]
knitr::kable(head(dataset))| bedrooms | price | availability_365 | number_of_reviews | review_scores_rating | room_type |
|---|---|---|---|---|---|
| 2 | 100 | 312 | 94 | 96 | Entire home/apt |
| 1 | 145 | 364 | 147 | 98 | Private room |
| 1 | 150 | 1 | 50 | 94 | Entire home/apt |
| 1 | 73 | 0 | 162 | 99 | Private room |
| 1 | 40 | 0 | 77 | 98 | Entire home/apt |
| 2 | 89 | 101 | 33 | 97 | Entire home/apt |
Sur les visualisations des boxplots suivants, les outliers sont représentés sous forme de points. Ils correspondent à des observations dont les valeurs sont :supérieures à la valeur du 3ème quartile plus 1.5 fois l’intervalle interquartile,ou inférieures à la valeur du 1er quartile moins 1.5 fois l’intervalle interquartile
### boxplot du prix fonction du quartier
#g<-qplot(room_type,log(price), data=listing2,geom=c("boxplot"),fill=property_type)
#ggplotly(g)
#bedrooms price availability_365 number_of_reviews review_scores_rating
dataset <- listing1[,-highlyCorrelated]
fig <- plot_ly(dataset, y = ~price, color = ~room_type, type = "box")
figNous constatons une dispersion assez presente de la variable price sur la categorie de chambre Entire home/apt ,le meme constat est fait pour les categori Private room.Par rapport aux catégorie Hotel room et Shared room qui sont moins dispersé.Ceci nous amene à traiter ces outliers par imputations car nous ne pouvons pas tout simplement les supprimer au risque de perdre la totale information relative au prix de chambre.
### boxplot du prix fonction du quartier
#g<-qplot(room_type,log(price), data=listing2,geom=c("boxplot"),fill=property_type)
#ggplotly(g)
#bedrooms price availability_365 number_of_reviews review_scores_rating
dataset <- listing1[,-highlyCorrelated]
fig <- plot_ly(dataset, y = ~bedrooms, color = ~room_type, type = "box")
figle meme constat est fait pour la variable bedrooms ou nous observons des valeurs extremes moins nombreuses mais trop eleve. mais avec la catégorie Shared room qui presente un seul points aberrant
### boxplot du prix fonction du quartier
#g<-qplot(room_type,log(price), data=listing2,geom=c("boxplot"),fill=property_type)
#ggplotly(g)
#bedrooms price availability_365 number_of_reviews review_scores_rating
dataset <- listing1[,-highlyCorrelated]
fig <- plot_ly(dataset, y = ~availability_365, color = ~room_type, type = "box")
figla variable availability_365 est bien plus stable en terme de dispersion et n’enregistre qu’un seul point aberrant sur la categorie Shared home
### boxplot du prix fonction du quartier
#g<-qplot(room_type,log(price), data=listing2,geom=c("boxplot"),fill=property_type)
#ggplotly(g)
#bedrooms price availability_365 number_of_reviews review_scores_rating
dataset <- listing1[,-highlyCorrelated]
fig <- plot_ly(dataset, y = ~number_of_reviews, color = ~room_type, type = "box")
figPlus de dispersion pour la variable number_of_reviews sur les catégories de chambre Entire home/apt et Privated room
### boxplot du prix fonction du quartier
#g<-qplot(room_type,log(price), data=listing2,geom=c("boxplot"),fill=property_type)
#ggplotly(g)
#bedrooms price availability_365 number_of_reviews review_scores_rating
dataset <- listing1[,-highlyCorrelated]
fig <- plot_ly(dataset, y = ~review_scores_rating, color = ~room_type, type = "box")
figPlus de dispersion pour la variable review_scores_rating sur les catégories de chambre Entire home/apt et Privated room
Nous allons utilise les quantiles pour proceder è l’imputation
outlier_norm <- function(x){
qntile <- quantile(x, probs=c(.25, .75))
caps <- quantile(x, probs=c(.05, .95))
H <- 1.5 * IQR(x, na.rm = T)
x[x < (qntile[1] - H)] <- caps[1]
x[x > (qntile[2] + H)] <- caps[2]
return(x)
}
#train_df$Age=outlier_norm(train_df$Age)
dataset$price=outlier_norm(dataset$price)
dataset$bedrooms=outlier_norm(dataset$bedrooms)
dataset$availability_365=outlier_norm(dataset$availability_365)
dataset$number_of_reviews=outlier_norm(dataset$number_of_reviews)
dataset$review_scores_rating=outlier_norm(dataset$review_scores_rating)Nous allons considéré l’ensemble de donnée dataset, sous lequel nous allons tout simplement appliqué les algorithme de classification multiclasse avec les données numerique en entrée. Nous allos donc renommé notre esemble de données airbnb, la catégorie que nous avons choisi est la variable :room_type, les autres variable à savoir: property_type et quartier pourront faire objet d’une etude future
airbnb<-dataset
knitr::kable(sapply(airbnb,class))| x | |
|---|---|
| bedrooms | numeric |
| price | numeric |
| availability_365 | numeric |
| number_of_reviews | numeric |
| review_scores_rating | numeric |
| room_type | factor |
Nous avons necessaire l’estimation des parametres du modele qu’on appelle ici ensemble de validation constitué de 20% des enregistrements de notre ensemble de donné airbnb, et les 80% restant seront consacré pour evaluer la performance de l’algoritheme et pour definir les parametres du modele
airbnb<-dataset
validation_index <- createDataPartition(airbnb$room_type, p=0.80, list=FALSE)
# selection de 20% d'enregistrement pour la validation
validation <- airbnb[-validation_index,]
# Le reste soit 80% de donn.ées pour l'apprentissage et test pour le modele
train <- airbnb[validation_index,]# 3. Summarize Dataset
# dimensions of dataset
knitr::kable(dim(train))| x |
|---|
| 1276 |
| 6 |
# list types for each attribute
knitr::kable(sapply(train, class))| x | |
|---|---|
| bedrooms | numeric |
| price | numeric |
| availability_365 | numeric |
| number_of_reviews | numeric |
| review_scores_rating | numeric |
| room_type | factor |
# take a peek at the first 5 rows of the data
knitr::kable(head(train))| bedrooms | price | availability_365 | number_of_reviews | review_scores_rating | room_type | |
|---|---|---|---|---|---|---|
| 1 | 2 | 100 | 312 | 94 | 96 | Entire home/apt |
| 2 | 1 | 145 | 364 | 182 | 98 | Private room |
| 3 | 1 | 150 | 1 | 50 | 94 | Entire home/apt |
| 4 | 1 | 73 | 0 | 182 | 99 | Private room |
| 5 | 1 | 40 | 0 | 77 | 98 | Entire home/apt |
| 7 | 2 | 98 | 270 | 182 | 84 | Entire home/apt |
# list the levels for the class
knitr::kable(levels(train$room_type))| x |
|---|
| Entire home/apt |
| Hotel room |
| Private room |
| Shared room |
# split input and output
x <- train[,1:5]
y <- train[,6]
# summarize the class distribution
percentage <- prop.table(table(train$room_type)) * 100
cbind(freq=table(train$room_type), percentage=percentage)## freq percentage
## Entire home/apt 935 73.275862
## Hotel room 24 1.880878
## Private room 306 23.981191
## Shared room 11 0.862069
# summarize attribute distributions
summary(train)## bedrooms price availability_365 number_of_reviews
## Min. :1.000 Min. : 14.0 Min. : 0.0 Min. : 1.00
## 1st Qu.:1.000 1st Qu.: 55.0 1st Qu.: 1.0 1st Qu.: 5.00
## Median :1.000 Median : 90.0 Median :142.0 Median : 20.00
## Mean :1.574 Mean :107.7 Mean :157.7 Mean : 43.82
## 3rd Qu.:2.000 3rd Qu.:140.0 3rd Qu.:285.0 3rd Qu.: 61.00
## Max. :3.000 Max. :292.2 Max. :365.0 Max. :182.00
## review_scores_rating room_type
## Min. : 83.00 Entire home/apt:935
## 1st Qu.: 93.00 Hotel room : 24
## Median : 97.00 Private room :306
## Mean : 95.32 Shared room : 11
## 3rd Qu.:100.00
## Max. :100.00
par(mfrow=c(1,5))
for(i in 1:5) {
boxplot(x[,i], main=names(train)[i])
}plot(y)# matrice scatterplot
featurePlot(x=x, y=y, plot="ellipse")# garphique pour chaque attribut: box et whisker
featurePlot(x=x, y=y, plot="box")# courbe de densité pour chaque attribute et par catégorie
scales <- list(x=list(relation="free"), y=list(relation="free"))
featurePlot(x=x, y=y, plot="density", scales=scales)Ces algorithmes ont été executer en utilisant la methode du 10-fold cross validation
control <- trainControl(method="cv", number=10)
metric <- "Accuracy"set.seed(7)
fit.lda <- train(room_type~., data=train, method="lda", metric=metric, trControl=control)set.seed(7)
fit.cart <- train(room_type~., data=train, method="rpart", metric=metric, trControl=control)set.seed(7)
fit.knn <- train(room_type~., data=train, method="knn", metric=metric, trControl=control)set.seed(7)
fit.svm <- train(room_type~., data=train, method="svmRadial", metric=metric, trControl=control)set.seed(7)
fit.rf <- train(room_type~., data=train, method="rf", metric=metric, trControl=control)results <- resamples(list(lda=fit.lda, cart=fit.cart, knn=fit.knn, svm=fit.svm, rf=fit.rf))
summary(results)##
## Call:
## summary.resamples(object = results)
##
## Models: lda, cart, knn, svm, rf
## Number of resamples: 10
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lda 0.7209302 0.7363281 0.7441096 0.7438228 0.7539370 0.7619048 0
## cart 0.7480315 0.7544526 0.7834821 0.7757288 0.7949219 0.8000000 0
## knn 0.7596899 0.7667411 0.7882628 0.7877106 0.8059618 0.8188976 0
## svm 0.7698413 0.7731846 0.7907452 0.7906828 0.7980560 0.8359375 0
## rf 0.7619048 0.7851562 0.8063367 0.8031848 0.8210035 0.8359375 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lda -0.01441678 0.04673192 0.07797826 0.0809770 0.1226302 0.1666667 0
## cart 0.25458547 0.33333333 0.35991562 0.3725797 0.4134124 0.5135291 0
## knn 0.34715026 0.37272655 0.38544073 0.4116044 0.4489994 0.5148646 0
## svm 0.28304458 0.35829478 0.39577832 0.4016609 0.4386408 0.5416098 0
## rf 0.36170213 0.42355612 0.47337809 0.4727484 0.5087810 0.5714490 0
dotplot(results)print(fit.rf)## Random Forest
##
## 1276 samples
## 5 predictor
## 4 classes: 'Entire home/apt', 'Hotel room', 'Private room', 'Shared room'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 1147, 1146, 1148, 1149, 1148, 1150, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.8031848 0.4727484
## 3 0.8023853 0.4763963
## 5 0.8008047 0.4760977
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
set.seed(7)
predictions <- predict(fit.rf, newdata=validation)
confusionMatrix(predictions, validation$room_type)## Confusion Matrix and Statistics
##
## Reference
## Prediction Entire home/apt Hotel room Private room Shared room
## Entire home/apt 208 3 34 1
## Hotel room 0 0 1 0
## Private room 25 2 41 1
## Shared room 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.788
## 95% CI : (0.7387, 0.8317)
## No Information Rate : 0.7373
## P-Value [Acc > NIR] : 0.02197
##
## Kappa : 0.4322
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Entire home/apt Class: Hotel room
## Sensitivity 0.8927 0.000000
## Specificity 0.5422 0.996785
## Pos Pred Value 0.8455 0.000000
## Neg Pred Value 0.6429 0.984127
## Prevalence 0.7373 0.015823
## Detection Rate 0.6582 0.000000
## Detection Prevalence 0.7785 0.003165
## Balanced Accuracy 0.7174 0.498392
## Class: Private room Class: Shared room
## Sensitivity 0.5395 0.000000
## Specificity 0.8833 1.000000
## Pos Pred Value 0.5942 NaN
## Neg Pred Value 0.8583 0.993671
## Prevalence 0.2405 0.006329
## Detection Rate 0.1297 0.000000
## Detection Prevalence 0.2184 0.000000
## Balanced Accuracy 0.7114 0.500000